home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 2 / CU Amiga Magazine's Super CD-ROM 02 (1996)(EMAP Images)(GB)[!][issue 1996-04].iso / magazine / amiga_e / cardapp.e < prev    next >
Text File  |  1994-04-06  |  13KB  |  489 lines
  1. OPT OSVERSION=37
  2.  
  3. MODULE 'workbench/startup', 'workbench/workbench', 'icon', 'wb',
  4.        'dos/dos', 'utility/date', 'utility'
  5.  
  6. CONST MEMSTART=$600000, BLOCKSIZE=$100, FILEINFOSIZE=$20, MAGIC=$2000
  7. CONST HEADEROFF=2*BLOCKSIZE, BLKPTRSIZE=2, FILELEN=13, DEL=0, START=0
  8. CONST FREEOFF=HEADEROFF+BLOCKSIZE, HEADER=HEADEROFF+MEMSTART
  9. CONST FREEBLOCKS=FREEOFF+MEMSTART, EOFB=$FFFE, EOC=$FFFF, LEN=FILELEN-1
  10. CONST VERB_COLS=2, NOVERB_COLS=3, SECSPERDAY=24*60*60
  11.  
  12. ENUM NO_ERR, BAD_CARD, NO_FREE, IN_USE, W_PROTECT, SHORT_FILE, DUP_FILE,
  13.      OPEN_LIB, MSG_PORT, DISK_OBJ, APP_ICON, APP_MENU, OPEN_ERR, MEM,
  14.      BAD_DIR, EXAM_ERR, LOCK_ERR, BAD_ARGS, TOO_BIG
  15. ENUM MY_ICON, MY_EXTR, MY_QUIT
  16.  
  17. OBJECT fileinfo
  18.   file, next
  19. ENDOBJECT
  20.  
  21. RAISE OPEN_LIB IF OpenLibrary()=NIL,
  22.       OPEN_ERR IF Open()=NIL,
  23.       MSG_PORT IF CreateMsgPort()=NIL,
  24.       DISK_OBJ IF GetDiskObject()=NIL,
  25.       APP_ICON IF AddAppIconA()=NIL,
  26.       APP_MENU IF AddAppMenuItemA()=NIL,
  27.       EXAM_ERR IF Examine()=NIL,
  28.       EXAM_ERR IF ExamineFH()=NIL,
  29.       LOCK_ERR IF Lock()=NIL,
  30.       MEM      IF New()=NIL
  31.  
  32. /* lastinfo is a block pointer with MAGIC, e.g., $213A (not $13A) */
  33. DEF thefiles:PTR TO fileinfo, lastfile:PTR TO fileinfo, lastinfo
  34.  
  35. PROC main() HANDLE
  36.   DEF myport=NIL, dobj=NIL:PTR TO diskobject, fh=NIL, oldstdout=NIL,
  37.       appicon=NIL, appmsg=NIL:PTR TO appmessage, appquit=NIL, appextr=NIL,
  38.       verbose=FALSE
  39.   fh:=Open('CON:0/11/640/110/Notepad Card/AUTO/CLOSE/WAIT', OLDFILE)
  40.   oldstdout:=SetStdOut(fh)
  41.   iconbase:=OpenLibrary('icon.library', 33)
  42.   workbenchbase:=OpenLibrary('workbench.library', 37)
  43.   utilitybase:=OpenLibrary('utility.library', 37)
  44.   myport:=CreateMsgPort()
  45.   dobj:=GetDiskObject('progdir:cardapp')
  46.   dobj.type:=NIL
  47.   verbose:=FindToolType(dobj.tooltypes, 'VERBOSE')
  48.   appicon:=AddAppIconA(MY_ICON,NIL,'- Notepad Card -',myport,NIL,dobj,NIL)
  49.   appextr:=AddAppMenuItemA(MY_EXTR,NIL,'Extract',myport,NIL)
  50.   appquit:=AddAppMenuItemA(MY_QUIT,NIL,'Quit CardApp',myport,NIL)
  51.   LOOP
  52.     WaitPort(myport)
  53.     WHILE appmsg:=GetMsg(myport)
  54.       IF appmsg.id=MY_QUIT
  55.         Raise(NO_ERR)
  56.       ELSEIF appmsg.id=MY_ICON
  57.         getinfo()
  58.         doicon(appmsg, verbose)
  59.         freeinfo(thefiles, thefiles.next)
  60.       ELSEIF appmsg.id=MY_EXTR
  61.         getinfo()
  62.         doextract(appmsg)
  63.         freeinfo(thefiles, thefiles.next)
  64.       ENDIF
  65.       ReplyMsg(appmsg)
  66.       appmsg:=NIL
  67.     ENDWHILE
  68.   ENDLOOP
  69.   Raise(NO_ERR)
  70. EXCEPT
  71.   IF appmsg THEN ReplyMsg(appmsg)
  72.   IF appquit THEN RemoveAppMenuItem(appquit)
  73.   IF appextr THEN RemoveAppMenuItem(appextr)
  74.   IF appicon THEN RemoveAppIcon(appicon)
  75.   IF dobj THEN FreeDiskObject(dobj)
  76.   IF myport
  77.     WHILE appmsg:=GetMsg(myport) DO ReplyMsg(appmsg)
  78.     DeleteMsgPort(myport)
  79.   ENDIF
  80.   IF utilitybase THEN CloseLibrary(utilitybase)
  81.   IF workbenchbase THEN CloseLibrary(workbenchbase)
  82.   IF iconbase THEN CloseLibrary(iconbase)
  83.   IF fh
  84.     SetStdOut(oldstdout)
  85.     Close(fh)
  86.   ENDIF
  87.   SELECT exception
  88.   CASE MEM
  89.     WriteF('-  Could not allocate memory  -\n')
  90.   CASE OPEN_ERR
  91.     WriteF('-  Cannot open output window  -\n')
  92.   CASE OPEN_LIB
  93.     WriteF('-  Cannot open required libraries  -\n')
  94.   CASE MSG_PORT
  95.     WriteF('-  Cannot create msg port  -\n')
  96.   CASE DISK_OBJ
  97.     WriteF('-  Cannot locate icon for CardApp  -\n')
  98.   CASE APP_ICON
  99.     WriteF('-  Cannot add AppIcon to Workbench  -\n')
  100.   CASE APP_MENU
  101.     WriteF('-  Cannot add AppMenuItem to Workbench  -\n')
  102.   CASE BAD_CARD
  103.     WriteF('-  No PCMCIA card, or not from Notepad  -\n')
  104.   CASE IN_USE
  105.     WriteF('-  PCMCIA card is in use, or not from Notepad  -\n')
  106.   CASE W_PROTECT
  107.     WriteF('-  No PCMCIA card, or write protected  -\n')
  108.   CASE NO_FREE
  109.     setwrite()
  110.     WriteF('-  No more free blocks -- card is full  -\n')
  111.   ENDSELECT
  112. ENDPROC
  113.  
  114. PROC doextract(appmsg:PTR TO appmessage) HANDLE
  115.   DEF f:PTR TO fileinfo, oldlock=NIL, lock=NIL, fib:fileinfoblock,
  116.       wargs:PTR TO wbarg, s
  117.   wargs:=appmsg.arglist
  118.   IF appmsg.numargs=1
  119.     IF wargs.lock=NIL THEN Raise(BAD_DIR)
  120.     IF s:=wargs.name
  121.       IF s[]<>0 THEN Raise(BAD_DIR)
  122.     ENDIF
  123.     Examine(wargs.lock,fib)
  124.     IF fib.direntrytype<0 THEN Raise(BAD_DIR)
  125.     oldlock:=CurrentDir(wargs.lock)
  126.   ELSEIF appmsg.numargs=0
  127.     lock:=Lock('Ram Disk:', ACCESS_READ)
  128.     oldlock:=CurrentDir(lock)
  129.   ELSE
  130.     Raise(BAD_ARGS)
  131.   ENDIF
  132.   f:=thefiles.next
  133.   WHILE f
  134.     extractfile(f.file)
  135.     f:=f.next
  136.   ENDWHILE
  137.   WriteF('*  Finished extracting files -- safe to remove card  *\n\n')
  138.   Raise(NO_ERR)
  139. EXCEPT
  140.   IF oldlock THEN CurrentDir(oldlock)
  141.   IF lock THEN UnLock(lock)
  142.   SELECT exception
  143.   CASE BAD_ARGS
  144.     WriteF('-  Select at most one directory  -\n')
  145.   CASE BAD_DIR
  146.     WriteF('-  Can only Extract to a directory  -\n')
  147.   CASE LOCK_ERR
  148.     WriteF('-  Cannot lock Ram: disk  -\n')
  149.   CASE EXAM_ERR
  150.     WriteF('-  Examine failed  -\n')
  151.   ENDSELECT
  152. ENDPROC
  153.  
  154. PROC extractfile(file) HANDLE
  155.   DEF b, fh, i
  156.   IF deleted(file)=FALSE
  157.     fh:=Open(filename(file), NEWFILE)
  158.     WriteF('Extracting file "\s"\n', filename(file))
  159.     b:=firstblock(file)
  160.     i:=filesize(file)
  161.     WHILE (b<>EOC) AND (b<>DEL)
  162.       Write(fh, address(b), IF i<BLOCKSIZE THEN i ELSE BLOCKSIZE)
  163.       i:=i-BLOCKSIZE
  164.       b:=follow(b)
  165.     ENDWHILE
  166.     Raise(NO_ERR)
  167.   ENDIF
  168. EXCEPT
  169.   IF fh THEN Close(fh)
  170.   SELECT exception
  171.   CASE OPEN_ERR
  172.     WriteF('-  Cannot open output file "\s"  -\n', filename(file))
  173.   ENDSELECT
  174. ENDPROC
  175.  
  176. PROC doicon(appmsg:PTR TO appmessage, verbose) HANDLE
  177.   DEF i, err, f:PTR TO fileinfo, wargs:PTR TO wbarg, oldlock=NIL, s, add
  178.   IF appmsg.numargs=0
  179.     f:=thefiles.next
  180.     i:=0
  181.     WHILE f
  182.       printfile(f.file, {i}, verbose)
  183.       f:=f.next
  184.     ENDWHILE
  185.     printfile(NIL, {i}, verbose)  /* Trailing linefeed? */
  186.     WriteF('*  End of Listing  *\n\n')
  187.   ELSE
  188.     IF (err:=checkwrite())<>NO_ERR THEN Raise(err)
  189.     wargs:=appmsg.arglist
  190.     add:=FALSE
  191.     FOR i:=1 TO appmsg.numargs  /* Loop through the arguments */
  192.       IF (wargs.lock<>NIL) AND (s:=wargs.name)
  193.         IF s[]<>0
  194.           oldlock:=CurrentDir(wargs.lock)
  195.           WriteF('Adding file "\s"\n', wargs.name)
  196.           IF addfile(wargs.name) THEN add:=TRUE
  197.           CurrentDir(oldlock) /* Important: restore current dir */
  198.           oldlock:=NIL
  199.         ELSE
  200.           WriteF('-  Ignoring directory  -\n')
  201.         ENDIF
  202.       ELSE
  203.         WriteF('-  Ignoring directory  -\n')
  204.       ENDIF
  205.       wargs++
  206.     ENDFOR
  207.     setwrite()
  208.     IF add
  209.       WriteF('*  Finished adding files -- safe to remove card  *\n\n')
  210.     ELSE
  211.       WriteF('*  No files selected  *\n\n')
  212.     ENDIF
  213.   ENDIF
  214. EXCEPT
  215.   IF oldlock THEN CurrentDir(oldlock)
  216.   Raise(exception)
  217. ENDPROC
  218.  
  219. PROC printfile(file, count, verbose)
  220.   IF file
  221.     IF deleted(file)=FALSE
  222.       ^count:=^count+1
  223.       IF verbose
  224.         WriteF('\l\s[12]  \r\d[5]', filename(file), filesize(file))
  225.         printdate(file)
  226.         WriteF(IF Mod(^count, VERB_COLS)=0 THEN '\n' ELSE '   ')
  227.       ELSE
  228.         WriteF('\l\s[12]  \r\d[5]\s', filename(file), filesize(file),
  229.                IF Mod(^count, NOVERB_COLS)=0 THEN '\n' ELSE '   ')
  230.       ENDIF
  231.     ENDIF
  232.   ELSE
  233.     IF Mod(^count, IF verbose THEN VERB_COLS ELSE NOVERB_COLS)<>0
  234.       WriteF('\n')
  235.     ENDIF
  236.   ENDIF
  237. ENDPROC
  238.  
  239. PROC printdate(file)
  240.   DEF date, year, month, day, hour, min
  241.   date:=filedate(file)
  242.   year:=Mod(90+Shr(date, 25), 100)
  243.   month:=Shr(date AND $1FFFFFF, 21)
  244.   IF (month>12) OR (month<1) THEN month:=0
  245.   day:=Shr(date AND $1FFFFF, 16)
  246.   hour:=Shr(date AND $FFFF, 11)
  247.   min:=Shr(date AND $7FF, 5)
  248.   WriteF(' \r\d[2]-\s-\z\d[2] \r\d[2]:\z\d[2]', day,
  249.          ListItem(['XXX', 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul',
  250.                    'Aug', 'Sep', 'Oct', 'Nov', 'Dec'], month),
  251.          year, hour, min)
  252. ENDPROC
  253.  
  254. PROC addfile(fname) HANDLE
  255.   DEF fh=NIL, file, b=START, next, len, i=0, going=TRUE,
  256.       f:PTR TO fileinfo, found=NIL, name, fib:fileinfoblock
  257.   fh:=Open(fname, OLDFILE)
  258.   name:=FilePart(fname)
  259.   ExamineFH(fh, fib)
  260.   IF fib.direntrytype>0 THEN Raise(BAD_DIR)
  261.   len:=fib.size
  262.   IF (len<=0) OR (len>$FFFF) THEN Raise(TOO_BIG)
  263.   f:=thefiles.next
  264.   WHILE f
  265.     IF deleted(f.file)
  266.       IF found=NIL THEN found:=f.file
  267.     ELSE
  268.       IF equal(name, filename(f.file)) THEN Raise(DUP_FILE)
  269.     ENDIF
  270.     f:=f.next
  271.   ENDWHILE
  272.   IF found
  273.     file:=found
  274.   ELSE
  275.     file:=FILEINFOSIZE+lastfile.file
  276.     IF Mod(file, BLOCKSIZE)=0
  277.       IF (b:=findfree(b))=EOFB THEN Raise(NO_FREE)
  278.       initblock(b)
  279.       useblock(lastinfo, b)
  280.       lastinfo:=b
  281.       useblock(b, EOC)
  282.       file:=address(b)
  283.     ENDIF
  284.   ENDIF
  285.   IF (b:=findfree(b))=EOFB THEN Raise(NO_FREE)
  286.   lastfile.next:=newfile(file)
  287.   lastfile:=lastfile.next
  288.   setfirstblock(file, b)
  289.   setname(file, name)
  290.   setdate(file, fib.datestamp)
  291.   going:=TRUE
  292.   WHILE (i<len) AND going
  293.     Read(fh, address(b), BLOCKSIZE)
  294.     i:=i+BLOCKSIZE
  295.     IF (next:=findfree(b))=EOFB
  296.       going:=FALSE
  297.     ELSE
  298.       useblock(b, next)
  299.       b:=next
  300.     ENDIF
  301.   ENDWHILE
  302.   useblock(b, EOC)
  303.   IF going=FALSE THEN Raise(SHORT_FILE)
  304.   setsize(file, len)
  305.   Raise(NO_ERR)
  306. EXCEPT
  307.   IF fh THEN Close(fh)
  308.   SELECT exception
  309.   CASE BAD_DIR
  310.     WriteF('-  Cannot add a directory  -\n')
  311.     RETURN FALSE
  312.   CASE TOO_BIG
  313.     WriteF('-  File "\s" is too large (or empty)  -\n', fname)
  314.   CASE OPEN_ERR
  315.     WriteF('-  Unable to open file "\s"  -\n', fname)
  316.   CASE EXAM_ERR
  317.     WriteF('-  Examine failed  -\n')
  318.   CASE DUP_FILE
  319.     WriteF('-  File "\s" already exists as "\s" -\n',
  320.            fname, filename(f.file))
  321.   CASE MEM
  322.     Raise(MEM)
  323.   CASE NO_FREE
  324.     Raise(NO_FREE)
  325.   CASE SHORT_FILE
  326.     setsize(file, i)
  327.     WriteF('-  File "\s" will be short  -\n', filename(file))
  328.     Raise(NO_FREE)
  329.   ENDSELECT
  330. ENDPROC TRUE
  331.  
  332. PROC getinfo()
  333.   DEF info, nofiles=FALSE, atend=FALSE, file, d
  334.   file:=HEADER
  335.   lastinfo:=firstblock(file)
  336.   thefiles:=lastfile:=newfile(file)
  337.   IF validate(file)
  338.     d:=filedate(file)
  339.     file:=file+FILEINFOSIZE
  340.     REPEAT   /* for all info blocks */
  341.       REPEAT /* for all files */
  342.         IF blank(file)
  343.           nofiles:=TRUE
  344.         ELSE
  345.           lastfile.next:=newfile(file)
  346.           lastfile:=lastfile.next
  347.           d:=filedate(file)
  348.           file:=file+FILEINFOSIZE
  349.           IF Mod(file, BLOCKSIZE)=0 THEN atend:=TRUE
  350.         ENDIF
  351.       UNTIL atend OR nofiles
  352.       IF atend
  353.         info:=follow(lastinfo)
  354.     IF (info<>EOC) AND (info<>DEL)
  355.           lastinfo:=info
  356.           file:=address(lastinfo)
  357.           atend:=FALSE
  358.         ELSE
  359.           nofiles:=TRUE
  360.         ENDIF
  361.       ENDIF
  362.     UNTIL nofiles
  363.   ELSE
  364.     Raise(BAD_CARD)
  365.   ENDIF
  366. ENDPROC
  367.  
  368. PROC freeinfo(this, next:PTR TO fileinfo)
  369.   Dispose(this)
  370.   IF next THEN freeinfo(next, next.next)
  371. ENDPROC
  372.  
  373. PROC checkwrite()
  374.   DEF err=NO_ERR, p
  375.   p:=HEADER+12
  376.   Forbid()
  377.   IF p[]=0
  378.     p[]:=1
  379.     IF p[]<>1 THEN err:=W_PROTECT
  380.   ELSE
  381.     err:=IN_USE
  382.   ENDIF
  383.   Permit()
  384. ENDPROC err
  385.  
  386. PROC setwrite()
  387.   DEF p
  388.   p:=HEADER+12
  389.   Forbid()
  390.   p[]:=0
  391.   Permit()
  392. ENDPROC
  393.  
  394. PROC equal(s, t)
  395.   DEF a[LEN]:STRING, b[LEN]:STRING
  396.   StrCopy(a, s, ALL)
  397.   StrCopy(b, t, ALL)
  398.   UpperStr(a)
  399.   UpperStr(b)
  400.   RETURN StrCmp(a, b, ALL)
  401. ENDPROC
  402.  
  403. PROC follow(block) RETURN int(blockaddr(block))
  404. PROC blockaddr(block) RETURN (block-MAGIC)*BLKPTRSIZE+FREEBLOCKS
  405. PROC blockptr(addr) RETURN (addr-FREEBLOCKS)/BLKPTRSIZE+MAGIC
  406. PROC address(block) RETURN (block-MAGIC)*BLOCKSIZE+MEMSTART
  407.  
  408. PROC useblock(block, next)
  409.   putint(blockaddr(block), next)
  410. ENDPROC
  411.  
  412. PROC initblock(block)
  413.   DEF p, i
  414.   p:=address(block)
  415.   FOR i:=1 TO BLOCKSIZE DO p[]++:=0
  416. ENDPROC
  417.  
  418. PROC validate(file)
  419.   RETURN StrCmp(filename(file), 'NC', 2) AND (firstblock(file)=HEADEROFF+MAGIC)
  420. ENDPROC
  421.  
  422. PROC blank(file)
  423.   DEF n
  424.   FOR n:=0 TO FILEINFOSIZE-1 DO IF file[]++<>0 THEN RETURN FALSE
  425. ENDPROC TRUE
  426.  
  427. PROC newfile(ptr)
  428.   DEF p:PTR TO fileinfo
  429.   p:=New(SIZEOF fileinfo)
  430.   p.file:=ptr
  431.   p.next:=NIL
  432. ENDPROC p
  433.  
  434. PROC findfree(block)
  435.   DEF p, b
  436.   p:=IF block<>START THEN blockaddr(block+1) ELSE FREEBLOCKS
  437.   WHILE (b:=int(p))<>EOFB
  438.     IF b=0 THEN RETURN blockptr(p)
  439.     p:=p+BLKPTRSIZE
  440.   ENDWHILE
  441.   RETURN EOFB
  442. ENDPROC
  443.  
  444. PROC setname(file, name)
  445.   DEF i, p
  446.   p:=file
  447.   FOR i:=0 TO FILELEN DO p[]++:=0
  448.   i:=StrLen(name)
  449.   CopyMem(name, file, IF i>=FILELEN THEN FILELEN-1 ELSE i)
  450. ENDPROC
  451.  
  452. PROC setdate(file, ds:PTR TO datestamp)
  453.   DEF secs, cd:clockdata, date
  454.   secs:=Mul(ds.days,SECSPERDAY)+(ds.minute*60)+(ds.tick/50)
  455.   Amiga2Date(secs, cd)
  456.   date:=Shl(cd.year-1990, 25) OR Shl(cd.month, 21) OR Shl(cd.mday, 16) OR
  457.         Shl(cd.hour, 11) OR Shl(cd.min, 5)
  458.   putlong(file+16, date)
  459. ENDPROC
  460.  
  461. PROC setsize(file, size)
  462.   putint(file+14, size)
  463. ENDPROC
  464.  
  465. PROC setfirstblock(file, block)
  466.   putint(file+20, block)
  467. ENDPROC
  468.  
  469. PROC putint(p, v)
  470.   p[]++:=v AND $FF
  471.   p[]:=Shr(v, 8) AND $FF
  472. ENDPROC
  473.  
  474. PROC putlong(p, v)
  475.   p[]++:=v AND $FF
  476.   p[]++:=Shr(v, 8) AND $FF
  477.   p[]++:=Shr(v, 16) AND $FF
  478.   p[]:=Shr(v, 24) AND $FF
  479. ENDPROC
  480.  
  481. PROC deleted(file) RETURN file[]=0
  482. PROC filename(file) RETURN file
  483. PROC filesize(file) RETURN int(file+14)
  484. PROC filedate(file) RETURN long(file+16)
  485. PROC firstblock(file) RETURN int(file+20)
  486.  
  487. PROC int(p) RETURN p[]++ OR Shl(p[],8)
  488. PROC long(p) RETURN p[]++ OR Shl(p[]++,8) OR Shl(p[]++,16) OR Shl(p[],24)
  489.